perm filename PAGEIF[RUT,LSP] blob
sn#267600 filedate 1977-03-05 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (DEFPROP PAGEIFY
C00005 ENDMK
Cā;
(DEFPROP PAGEIFY
(LAMBDA (L)
(PROG (DEV)
(SETQ DEV (QUOTE DSK:))
LOOP (COND ((NULL L) (RETURN NIL)))
(COND ((%DEVP (CAR L)) (SETQ DEV (CAR L)) (SETQ L (CDR L))))
(PAGEFILE (LIST DEV (CAR L))
(LIST (QUOTE DSK:)
(CONS (COND ((ATOM (CAR L)) (CAR L))
(T (CAAR L)))
(QUOTE PAG))))
(SETQ L (CDR L))
(GO LOOP)))
FEXPR)
(DE PAGEFILE (INFILE OUTFILE)
(PROG (LINCNT)
(INC (EVAL (CONS (QUOTE INPUT) (CONS (GENSYM) INFILE))))
(OUTC (EVAL (CONS (QUOTE OUTPUT) (CONS (GENSYM) OUTFILE))))
(LINELENGTH)
(SETQ LINCNT 1)
(PAGEREADS)
(INC NIL T)
(OUTC NIL T)
(RETURN NIL)))
(DE PAGEREADS NIL
(PROG (CH)
LOOP (SETQ CH (ERRSET (READCH)))
(COND ((ATOM CH) (RETURN NIL)))
(SETQ CH (CAR CH))
(COND ((EQUAL CH (QUOTE !)) (PRINC *FF)) (T (PRINC CH)))
(GO LOOP)))
(MAPCAR (FUNCTION (LAMBDA (PAIR)
(PROG2 (SET (CAR PAIR) (INTERN (ASCII (CADR PAIR))))
(CAR PAIR))))
(QUOTE ((*SP 40) (*TB 11)
(*CR 15)
(*LF 12)
(*VT 13)
(*FF 14)
(*CO 54)
(*PT 56)
(*LP 50)
(*RP 51)
(*SL 57)
(*AM 33)
(*AT 100)
(*RO 177)
(*COLON 72)
(*LB 133)
(*RB 135))))